home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
vmmngr.arc
/
VMM.IN3
< prev
next >
Wrap
Text File
|
1990-07-16
|
12KB
|
391 lines
{*********************************************************}
{* VMM.IN3 1.00 *}
{*********************************************************}
procedure ErrorExit(Code : Word);
{-Make some housekeeping before halting program}
var
i : Byte;
P : VMMPtr;
begin
{if critical error, program will free all allocated Ems handles before exit}
for i := 0 to Pred(VmmInstances.GetValidElems) do begin
VmmInstances.GetElem(i, P);
P^.Done;
end;
RunError(Code);
end;
{---------------------------------------------------------------------}
{+++ VMM public methods +++}
constructor VMM.Init(SwapFName : PathStr);
{-Create a new virtual memory manager with default options}
var
DefEmsToKeep : Word;
PagesAVail : Word;
begin
{Evaluate how much EMS memory is available - Keep 10% free}
if VmmEmsInstalled then begin
PagesAvail := EmsPagesAvail;
if PagesAvail <> EmsErrorCode then
DefEmsToKeep := PagesAvail div 10; {10% not used by VMM}
end
else
DefEmsToKeep := NoEms; {Prevent VMM from using Ems}
if not VMM.InitCustom(MaxHeapAlloc, {65521 bytes}
DefIncr, {128 bytes}
DefFreeEntries div 2, {1024 entries = 4096 bytes}
DefFreeEntries, {2048 entries = 8192 bytes}
DefQueueEntries, {512-1 entries}
DefEmsToKeep, {10% of Ems pages avail.}
DefDskToKeep, {1meg}
SwapFName) then
Fail;
end;
constructor VMM.InitCustom(RamSize : LongInt;
Incr, MaxVmmEntries,
MaxFreeEntries, VmmQueueEntries,
EmsPagesToKeep : Word;
DskToKeep : LongInt;
SwapFName : PathStr);
{-Create a new virtual memory manager with custom options}
var
Err : Word;
P : Pointer;
begin
if (not Root.init) then
Fail;
{Initialize VMM data objects}
if (not vmRamFreeList.Init(MaxFreeEntries, Incr))
or (VmmEmsInstalled
and (not vmEmsFreeList.Init(MaxFreeEntries, Incr)))
{if Ems not present doesn't initialize EmsFreeList}
or (not vmDskFreeList.Init(MaxFreeEntries, Incr))
or (not vmDescTable.Init(MaxVmmEntries, SizeOf(VmmDescriptor), Incr)
or (not vmLruQueue.Init(VmmQueueEntries*SizeOf(VmmHandle),
SizeOf(VmmHandle), true)))
then begin
Done;
Fail;
{InitStatus has been loaded by FreeList or Queue constructor}
end;
{Initialize Ram area - may be greater than 64k if the user-defined}
{ UserGetMem function provides this capability}
if not UserGetMem(vmRamArea, RamSize) then begin
Done;
InitStatus := epFatal+ecOutOfMemory;
Fail;
end
else begin
vmRamAreaSize := RamSize;
{Create a free entry for the whole Ram area}
{ so there is no need for a heap pointer}
with vmRamFreeList do
if AddFreeEntry(vmRamArea, vmRamAreaSize) <> vmRamAreaSize then begin
Done;
InitStatus := epFatal+ecOutOfRamEntries;
Fail;
end;
end;
{Initialize options}
vmOptions := DefVmmOptions;
vmStatus := 0;
{Process disk related information}
vmSwapFName := SwapFname;
if vmSwapFName = '' then
vmOptionsOff(vmUseDsk)
else begin
vmDskToKeep := DskToKeep;
vmEofPtr := 0;
{Open swap file}
vmSwapFName := FExpand(vmSwapFName);
Assign(vmF, vmSwapFName);
Rewrite(vmF, 1); {This way we can write blocks of any size}
Err := IoResult;
if Err <> 0 then begin
Done;
InitStatus := epFatal+Err;
Fail;
end;
end;
{Process Ems related information}
vmEmsToKeep := EmsPagesToKeep;
if (not VmmEmsInstalled)
or (vmEmsToKeep = NoEms) then
if vmOptionsAreOn(vmUseDsk) then
vmOptionsOff(vmUseEms)
else begin
{No resources for virtual memory}
Done;
InitStatus := epFatal+ecNoResources;
Fail;
end
else begin
P := EmsPageFramePtr;
vmEmsBaseSeg := VmmPtrRec(P).Seg;
{Offset part of returned pointer is always 0}
end;
{Increment VmmInstances number of elements by one and store pointer}
P := @Self;
with VmmInstances do
SetElem(GetValidElems, P);
{Prevent deadlocks by keeping at least 3*vmRamAreaSize bytes}
{ free on both virtual media}
Inc(VmmRamAreaSizeGlb, vmRamAreaSize*3);
end;
destructor VMM.Done;
{-Destroy a virtual memory manager}
var
Err : Word;
begin
vmRamFreeList.Done;
if VmmEmsInstalled then
vmEmsFreeList.Done;
vmDskFreeList.Done;
vmDescTable.Done;
UserFreeMem(vmRamArea, vmRamAreaSize);
if vmOptionsAreOn(vmUseDsk) then
Close(vmF);
if vmOptionsAreOn(vmDeleteSwap) then
Erase(vmF);
Err := IoResult;
Dec(VmmRamAreaSizeGlb, vmRamAreaSize*3);
Root.Done;
end;
function VMM.PeekStatus : Word;
{-Return VMM status}
begin
PeekStatus := vmStatus;
end;
function VMM.GetStatus : Word;
{-Return and reset VMM status}
begin
GetStatus := vmStatus;
vmStatus := 0;
end;
procedure VMM.Error(Code : Word);
{-Assign error code}
begin
vmStatus := Code;
end;
procedure VMM.LinkToDerefHandler;
{-Instruct the dereference interrupt handler to refer to THIS manager}
begin
VmmActiveMgr := @Self;
end;
function VMM.Lock(var Pt; Lockit : Boolean) : Boolean;
{-Lock or Unlock a VMM block in Ram}
var
H : Word;
P : Pointer absolute Pt;
D : VmmDescriptor;
begin
Lock := false;
if P = nil then
Exit;
H := VmmPtrRec(P).Seg;
{Get descriptor in descriptor table}
vmDescTable.GetElem(H, D);
if vmDescTable.GetStatus <> 0 then
exit;
if Lockit then begin
SetByteFlag(D.Location, vmLocked); {lock it}
vmLruQueue.Remove(H); {Cannot be paged out any more}
end
else begin
ClearByteFlag(D.Location, vmLocked); {unlock it}
vmLruQueue.Remove(H);
vmLruQueue.PushTail(H); {Now can be paged out again}
end;
{Update descriptor table entry}
vmDescTable.SetElem(H, D);
Lock := vmDescTable.GetStatus = 0;
end;
procedure VMM.GetMemV(var Pt; BlkSize : Word);
{-Allocate a memory block and return a Vmm "pointer" in P}
var
H : Word;
D : VmmDescriptor;
P : Pointer absolute Pt;
begin
if (BlkSize <= MaxHeapAlloc)
and (BlkSize > 0)
and ((RamMaxAvail >= BlkSize)
or
(((EmsPagesAvail*EmsPage-VmmRamAreaSizeGlb >= BlkSize)
or
(DskMaxAvail-VmmRamAreaSizeGlb >= BlkSize))
and
(PageOut(BlkSize)))) then begin
{Scan RamFreeList for a free block or allocate a new one...}
{ or page out until enough room is available}
{ Don't allocate if there isn't enough room in Ems or on disk}
{ to securely page out entire RamArea of all VMMs - prevent dead lock}
P := vmRamFreeList.GetFreeEntry(BlkSize); {Result cannot be nil}
{Convert to a VMM pointer and create new entry in descriptor table}
H := GetHandle;
if H = OutOfHandles then begin {Descriptor table out of entries}
P := nil;
Exit;
end;
D.Location := vmInRam; {All other values are null}
D.RamPtr := P; {Point to block in Ram area}
D.Size := BlkSize;
vmDescTable.SetElem(H, D); {Update descriptor table}
VmmPtrRec(P).Seg := H; {Handle goes in segment part of P}
VmmPtrRec(P).Ofs := VmmMark; {Offset of VMMptr is always $FFFF}
vmLruQueue.Remove(H);
vmLruQueue.PushTail(H); {Add the handle to the LRU queue}
end
else begin
{No space to allocate in Ram and PageOut failed}
{ not enough memory or too many locked blocks}
P := nil;
Exit;
end;
end;
procedure VMM.FreeMemV(var Pt);
{-Free a block and set P to nil}
var
H : Word;
P : Pointer absolute Pt;
D : VmmDescriptor;
begin
if VmmPtrRec(P).Ofs = VmmMark then begin
vmDescTable.GetElem(VmmPtrRec(P).Seg, D);
H := VmmPtrRec(P).Seg;
if vmDescTable.GetStatus = 0 then begin
case D.Location and vmLocation of
vmInRam : if vmRamFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
Error(epNonFatal+ecOutOfRamEntries);
vmInEms : if vmEmsFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
Error(epNonFatal+ecOutOfEmsEntries);
vmOnDsk : if vmDskFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
Error(epNonFatal+ecOutOfDskEntries);
else ErrorExit(204); {Invalid pointer operation}
end;
P := nil;
{Indicate that this handle is free}
FillChar(D, SizeOf(D), 0);
vmDescTable.SetElem(H, D);
{Remove it from the LRU queue}
vmLruQueue.Remove(H);
end
else
ErrorExit(213);
end
else
ErrorExit(204); {Invalid pointer operation}
end;
function VMM.GetSize(var Pt) : Word;
{-Return size of block pointed to by Pt}
var
P : Pointer absolute Pt;
D : VmmDescriptor;
begin
vmDescTable.GetElem(VmmPtrRec(P).Seg, D);
if vmDescTable.GetStatus = 0 then
GetSize := D.Size
else
GetSize := 0;
end;
function VMM.ClearRamArea : Boolean;
{-Page out all blocks unless they are locked}
begin
if RamMaxAvail < vmRamAreaSize then
ClearRamArea := PageOut(vmRamAreaSize)
{May fail if blocks are locked}
else
ClearRamArea := true;
end;
function VMM.RamMaxAvail : LongInt;
{-Return size of the largest block available in RAM area}
begin
RamMaxAvail := vmRamFreeList.MaxFree;
end;
function VMM.EmsMaxAvail : LongInt;
{-Return amount of memory available in Ems}
var
PagesFree : LongInt;
begin
if not vmOptionsAreOn(vmUseEms) or (vmEmsToKeep = NoEms) then begin
EmsMaxAvail := 0;
Exit;
end;
PagesFree := EmsPagesAvail;
if (PagesFree <> EmsErrorCode) and (PagesFree >= vmEmsToKeep+4) then
EmsMaxAvail := MaxEmsBlock
else
EmsMaxAvail := vmEmsFreeList.MaxFree;
end;
function VMM.DskMaxAvail : LongInt;
{-Return amount of space available on disk for VMM}
var
S : LongInt;
R : Registers;
begin
if not vmOptionsAreOn(vmUseDsk) or (vmSwapFName = '') then begin
DskMaxAvail := 0;
Exit;
end;
with R do begin
AX := $3600;
DX := Ord(Upcase(vmSwapFName[1]))-64;
MsDos(R);
if (BX = 0) or (AX = $FFFF) then
DskMaxAvail := 0
else begin
S := LongInt(AX)*LongInt(BX)*LongInt(CX)-vmDskToKeep;
DskMaxAvail := MaxLong(S, vmDskFreeList.MaxFree);
end;
end;
end;
procedure VMM.vmOptionsOn(OptionFlags : Word);
{-Activate multiple options}
begin
SetFlag(vmOptions, OptionFlags and not BadVmmOptions);
end;
procedure VMM.vmOptionsOff(OptionFlags : Word);
{-Deactivate multiple options}
var
SaveOptions : Word;
begin
SaveOptions := vmOptions and (vmUseDsk+vmUseEms);
ClearFlag(vmOptions, OptionFlags and not BadVmmOptions);
{Cannot clear both vmUseEms and vmUseDsk flags}
if vmOptions and (vmUseDsk+vmUseEms) = 0 then
vmOptions := vmOptions or SaveOptions;
end;
function VMM.vmOptionsAreOn(OptionFlags : Word) : Boolean;
{-Return true if all specified options are on}
begin
vmOptionsAreOn := (vmOptions and OptionFlags = OptionFlags);
end;